perm filename 12X13[SCR,LCS] blob sn#655203 filedate 1982-04-23 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	PRECEDE
C00007 ENDMK
CāŠ—;
PRECEDE;
FUNC FUN; < F1, F2, F3, F4, F5, F6
COMMON TOOT   TOOT CLAR BRIT BUZZ;
COMMON REVRB;
*
REVRB 0 1;
P2 12;END;
CLAR ;  < SAMSON BOX VERSION
P2 RH/13X13/4;
P3 C4;
P4 .6 ; P5 F2;
P6 F4;
 P13 FU/1/4/5;
P7 .1 ALL;
P18 NU/0/1/2/3/4/5/6/7/8/9/10/11/12/13/FINE;
P19 SUBN 13;
END;
BUZZ 0 0 13;
P2 RH/12X12/4;
P3 NO/C2/CS/D/DS/E/F/FS/G/GS/A/AS/B/C3;
P4 1.1 ; P5 F3;
P6 F6;
 P13 F6;
END;
  TEMPO/2 40 200/2 200 60;
  
C***RHY.F4 *****
	DIMENSION I(50),Z(10)
1	FORMAT(' TYPE X,Y1,Y2,...ETC. <CR> '/
	1 '  WHERE   X=THE NUMBER OF EQUAL DIVISIONS OF Y'/
	1 '   AND    Y=RHYTHMIC VALUES.  (E.G.  2. = DOTTED HALF)'/
	1 '                 H=HELP '/)
5	FORMAT('  ')
2	FORMAT(12F)
3	FORMAT(' THE NOTE VALUE =',F8.4)
6	FORMAT(50A1)
4	TYPE 5
	TYPE 1
	TYPE 5
	ACCEPT 6,I
	IF(I(1).EQ.'H'.OR.I(1).EQ.'?')GO TO 11
	REREAD 2,X,Y,Z
	IF(X.EQ.0)CALL EXIT
	IDOT=0
	DO 7 K=4,10
7	IF(I(K).EQ.'.'
	1 .aND.(I(K+1).EQ.' '.OR.I(K+1).EQ.'.'))IDOT=IDOT+1
	Y=4./Y
	IF(IDOT.EQ.0)GO TO 88
	V=Y
	DO 10 K=1,IDOT
	V=V/2.
10	Y=V+Y
	IF(Z(1).EQ.0)GO TO 9
88	DO 8 K=1,10
8	IF(Z(K).NE.0)Y=Y+4./Z(K)
9	V=4.*(X/Y)
	TYPE 5
	TYPE 3,V
	GO TO 4
11	TYPE 12
	GO TO 4
12	FORMAT(' ONLY THE 1ST RHYTHMIC VALUE CAN BE DOTTED.'/
	1 '  UP TO 10 VALUES FOR "Y" CAN BE TYPED.'/
	1 ' FOR EXAMPLE:'/
	1 ' TO GET 7 IN THE TIME OF A NORMAL TRIPLET (12TH NOTE) '/
	1 ' TIED TO A HALF TIED TO A SIXTEENTH, TYPE:'/
	1 '     7  12 2 16 <CR>'/
	1 ' TO GET 11 IN THE TIME OF A DOTTED QUARTER, TYPE:'/
	1 '     11 4.  <CR>'/)
	END


;OPENIT.FAI ****  FORTRAN LOOKUP ROUTINE -- STUFFS NEW CODE INTO IFILE-OFILE
; CAN USE DEVICE NUMBERS 1, 20, 21, 22, 23, 24   (BUT NO PPN'S YET)

	TITLE OPENIT
	INTERNAL OPENIT
	EXTERNAL FCM1,TEMP.,IFILE,OFILE
;;	EXTERNAL FCM1,FNCTN.,TEMP.,IFILE,OFILE

NOEXT:	PUSHJ 17,ZEXT
YESEXT:	PUSHJ 17,ZEXT+2
ZEXT:	SETZM TEMP.+1	;FOR NO EXTENSION
	POPJ 17,
	MOVE 0,EXT#
	MOVEM TEMP.+1	;STUFF IN THE EXTENSION
	POPJ 17,
NOFIND:	JRST NOFILE
NOFILE:	OUTSTR [ASCIZ/***** FILE NOT FOUND *****/]
	EXIT

;   CALL OPENIT(DEVICE#,NAME,EXT,[IN=0  OUT=1])

OPENIT:	0
	MOVE 0,NOFIND
	MOVEM 0,FCM1+14		;STUFF IN NO FILE FOUND TRAP
	MOVE 0,@(16)
	MOVEM 0,DEVICE#
	MOVE 0,@1(16)
	MOVEM 0,NAME#
	MOVE 0,@2(16)
	JUMPE 0,NONE		;0 OR BLANK OK FOR NO EXTENSION
	CAMN 0,[ASCIZ/     /]	;SEND EXTENSION IN A5 FORMAT ONLY!!!
	JRST NONE
	MOVEM 0,EX#		;NOW CONVERT EXTENSION TO SIXBIT
	MOVE 1,[POINT 7,EX]
	MOVE 2,[POINT 6,EXT]
	SETZM EXT#
	MOVEI 3,3	;LOOK AT FIRST 3 CHARACTERS ONLY
INF1:	ILDB 0,1	;LOOP 3 TIMES
	CAIN 0," "	;LESS THAN 3 CHARACTERS?
	JRST OPE2
	SUBI 0,40
	IDPB 0,2
	SOJG 3,INF1
OPE2:	MOVE 0,YESEXT	;THERE IS AN EXTENSION
	SKIPA
NONE:	MOVE 0,NOEXT	;NO EXTENSION
;;	MOVEM 0,FNCTN.-7  ;ONLY NEEDS ONE LOOKUP NOW.
  	MOVEM 0,FCM1-3	;CAUSES BOTH FORTRAN LOOKUPS TO DO THE SAME THING.
	SKIPE @3(16)	;0=INPUT  1=OUTPUT
	JRST OUTFIL
	JSA 16,IFILE	;OLD FORTRAN ROUTINES
	JUMP DEVICE
	JUMP NAME
	JRA 16,4(16)
OUTFIL:	JSA 16,OFILE	;OLD FORTRAN ROUTINES
	JUMP DEVICE
	JUMP NAME
	JRA 16,4(16)
	END